{$N+,E+,F+,X+}  {* Link with full 8087 emulator, uses 8087 if present *}
UNIT q_StdHdr;

{*---------------------------------------------------------------------
	 Copyright (c) Quinn-Curtis, 1992
	 Filename:  STDHDR.PAS
	 Revision:  8.01 LAB
	 Date:      6/15/92
	 Description:
                 Defines essential constants and data types used
                 throughout this software
-------------------------------------------------------------------*}

INTERFACE
uses WinCRT,WinDOS;

{$DEFINE QC_MEMERROR

{$DEFINE INC_SEGWIN}
{$DEFINE INC_SECNTRLS}
{$DEFINE INC_QCCNTRLS}
{$DEFINE INC_QCMENU}
{$DEFINE INC_QCDIALOG}
{$DEFINE INC_QCCACHE}

{$DEFINE INC_RTMOUSE}
{$DEFINE VA2DFFT}

CONST maxr = 64;
      maxc = 64;
      maxv = 256;
      maxrv = 8190;
      maxiv =32760;
      max3dv = 2000;

 MAX_LONG_VALUE: LONGINT =  2147483647;
 defaultbgidir: string = 'c:\bp\bgi';
 defaultgraphdir: string = 'c:\bp\bgi';

 _PRINTER_WRITE  =0;
 _PRINTER_INIT   =1;
 _PRINTER_STATUS =2;

TYPE
    RealType = SINGLE;
    string80  = string[ 80 ];
    OpType = (_plus,_minus,_multiply,_divide,_invert,_cmod);
    ComplexType = record
                     r: RealType;
                     i: RealType;
                   end;
    pShortVector = ^ShortVector;
    ShortVector  =          ARRAY[0..maxc] of RealType;
    LongVector   =          ARRAY[0..maxr] OF RealType;
    VeryLongVector =        ARRAY[0..maxv] of RealType;
    LongestRealVector  =    ARRAY[0..maxrv] OF RealType;
    LongestIntVector  =    ARRAY[0..maxiv] OF INTEGER;

    CShortVector  =         ARRAY[0..maxc] of ComplexType;
    CLongVector   =         ARRAY[0..maxr] OF ComplexType;
    Recmat  =               ARRAY[0..maxr] OF ShortVector;
    pRecmat  =              ARRAY[0..maxr] OF pShortVector;
    Sqrmat  =               ARRAY[0..maxc] OF ShortVector;
    CRecmat  =              ARRAY[0..maxr] OF CShortVector;
    CSqrmat  =              ARRAY[0..maxc] OF CShortVector;
    strVector =             ARRAY[0..maxc] of string80;
    FileNameType =          string80;
    TitleStr =              string80;
    IntArrayType = ARRAY[0..32] OF INTEGER;
    RealArrayType = ARRAY[0..32] OF realtype;

  realpntr = ^realtype;
  intpntr = ^INTEGER;
  wordpntr = ^WORD;
  bytepntr = ^BYTE;

  matstruct = record              {structure for virtual arrays}
                  mr, mc, modef: WORD;
                  mpntr: ^RealPntr;
              end;
 _string40 = string[40];    { old stagtype }
 _s40pntr = ^_string40;
 _string80 = string[80];   { old titletype }
 _s80pntr = ^_string80;
 _string120 = string[120];   { old titletype }
 _stringpntr = ^string;
  _CString = ARRAY[0..255] OF CHAR;
  _CStrPntr = ^_CString;
  pnt2d = RECORD  x, y: INTEGER; END;

  irect = RECORD left, top, right, bottom: INTEGER; END;
         WorldRect = RECORD
                  left, bottom, right, top : RealType;
          END;

          Rect = RECORD
                   left, bottom, right, top : INTEGER;
          END;

  TagArrayType = ARRAY[0..32] OF _string40;
  BYTEFILE = FILE OF BYTE;

CONST
  M_PI: realtype =   3.141592;

FUNCTION GetMatError: INTEGER;
FUNCTION _bios_printer(mode, p : integer; c : char): INTEGER;
FUNCTION HeapERRORFUNC(size: WORD): INTEGER;
FUNCTION HeapOverflow(size: longint): BOOLEAN;
FUNCTION MaxInt(a,b: INTEGER): INTEGER;
FUNCTION MinInt(a,b: INTEGER): INTEGER;
FUNCTION MaxReal(a,b: realtype): realtype;
FUNCTION MinReal(a,b: realtype): realtype;
FUNCTION  PntrAddNum (p: POINTER; n, len: INTEGER): POINTER;
FUNCTION GetPntrS80(p: POINTER; n: WORD): STRING;
PROCEDURE PutPntrS80(p: POINTER; n: WORD; s:STRING);
FUNCTION GetPntrS40(p: POINTER; n: WORD): STRING;
PROCEDURE PutPntrS40(p: POINTER; n: WORD; s:STRING);
FUNCTION GetPntrReal(p: POINTER; n: WORD): REALTYPE;
PROCEDURE PutPntrReal(p: POINTER; n: WORD; r:REALTYPE);
FUNCTION GetPntrInt(p: POINTER; n: WORD): INTEGER;
PROCEDURE PutPntrInt(p: POINTER; n: WORD; i:INTEGER);
FUNCTION GetPntrWord(p: POINTER; n: WORD): WORD;
PROCEDURE PutPntrWord(p: POINTER; n: WORD; i:WORD);
FUNCTION GetPntrByte(p: POINTER; n: WORD): BYTE;
PROCEDURE PutPntrByte(p: POINTER; n: WORD; value: BYTE);
PROCEDURE qcprintmemerror( err: INTEGER);
PROCEDURE memerrfunction( err: INTEGER);
PROCEDURE qcmemerrfunction( err: INTEGER);
FUNCTION qcgetmemerror: INTEGER;
FUNCTION rtpowercalc( realnum,  power: realtype): realtype;
FUNCTION rtrandom: realtype;
FUNCTION getthevideomode: INTEGER;
FUNCTION setthevideomode( vmode: INTEGER): INTEGER;
FUNCTION  getcoreleft(VAR maxblock: LONGINT): LONGINT;
PROCEDURE DefMat(VAR m: matstruct; r,c: WORD; VAR err: integer);
PROCEDURE FreeMat(VAR m: matstruct);
PROCEDURE WrMat(m: matstruct; r,c: WORD; v: REALTYPE);
FUNCTION  RdMat(m: matstruct; r,c: WORD): REALTYPE;
PROCEDURE CpyMat2Pntr(m: matstruct; c: word;
                      p: POINTER; n: word);
PROCEDURE SetWorldRect (VAR r: worldRect;
                       left, bottom, right, top : RealType );
FUNCTION CNOT(i: INTEGER): INTEGER;

IMPLEMENTATION

VAR
 virtualerr, rtlastmemerror, soundcontrol, heaperrorflag: INTEGER;
 sizerealtype, sizereal, sizesingle, sizedouble, sizeinteger, sizes40,
 sizes80,sizepointer, sizelong: WORD;

FUNCTION CNOT(i: INTEGER): INTEGER;
BEGIN
  IF (i <> 0) THEN i := 0 else i := 1;
  CNOT := i;
END;

FUNCTION HeapErrorFunc(size: WORD): INTEGER;
BEGIN
  if (size <> 0) THEN BEGIN END;
  HeapErrorFunc := 0;
END;

{** POINTER FUNCTIONS **}
FUNCTION  PntrAddNum (p: POINTER; n, len: INTEGER): POINTER;
TYPE
 LONG = record
   Lp, Hp: WORD;
 END;
VAR memofs, memseg, offset, sum: WORD;
    _result: POINTER;
BEGIN
  offset := (n*len);
  memofs := LONGINT(p) AND $FFFF;
  memseg := LONGINT(p) shr 16;
  sum :=memofs + offset;
  _result := PTR(memseg,sum);
  PntrAddNum := _result;
END;

{reads value from element pointed to by p+n}
FUNCTION GetPntrS80(p: POINTER; n: WORD): STRING;
VAR spntr: _s80pntr;
BEGIN
    spntr := PntrAddNum(p,n,sizes80);
    GetPntrS80 := spntr^;
END;

{write value to element pointed to by p+n}
PROCEDURE PutPntrS80(p: POINTER; n: WORD; s:STRING);
VAR spntr: _s80pntr;
BEGIN
  spntr := PntrAddNum(p,n,sizes80);
  spntr^ := s;
END;


{reads value from element pointed to by p+n}
FUNCTION GetPntrS40(p: POINTER; n: WORD): STRING;
VAR spntr: _s40pntr;
BEGIN
    spntr := PntrAddNum(p,n,sizes40);
    GetPntrS40 := spntr^;
END;

{write value to element pointed to by p+n}
PROCEDURE PutPntrS40(p: POINTER; n: WORD; s:STRING);
VAR spntr: _s40pntr;
BEGIN
  spntr := PntrAddNum(p,n,sizes40);
  spntr^ := s;
END;

{reads value from element pointed to by p+n}
FUNCTION GetPntrReal(p: POINTER; n: WORD): REALTYPE;
VAR rpntr: ^REALTYPE;
BEGIN
  GetPntrReal := REALTYPE(PntrAddNum(p,n,sizerealtype)^);
END;

{write value to element pointed to by p+n}
PROCEDURE PutPntrReal(p: POINTER; n: WORD; r:REALTYPE);
VAR rpntr: ^REALTYPE;
BEGIN
  rpntr := PntrAddNum(p,n,sizerealtype);
  rpntr^ := r;
END;

{reads integer value from element pointed to by p+n}
FUNCTION GetPntrInt(p: POINTER; n: WORD): INTEGER;
BEGIN
  GetPntrInt := INTEGER(PntrAddNum(p,n,sizeinteger)^);
END;

{write integer value to element pointed to by p+n}
PROCEDURE PutPntrInt(p: POINTER; n: WORD; i:INTEGER);
VAR ipntr: ^INTEGER;
BEGIN
  ipntr := PntrAddNum(p,n,sizeinteger);
  ipntr^ := i;
END;

{reads integer value from element pointed to by p+n}
FUNCTION GetPntrWord(p: POINTER; n: WORD): WORD;
BEGIN
  GetPntrWord := WORD(PntrAddNum(p,n,sizeinteger)^);
END;

{write integer value to element pointed to by p+n}
PROCEDURE PutPntrWord(p: POINTER; n: WORD; i:WORD);
VAR ipntr: ^WORD;
BEGIN
  ipntr := PntrAddNum(p,n,sizeinteger);
  ipntr^ := i;
END;

{reads byte value from element pointed to by p+n}
FUNCTION GetPntrByte(p: POINTER; n: WORD): BYTE;
VAR ipntr: ^BYTE;
BEGIN
  GetPntrByte := BYTE(PntrAddNum(p,n,1)^);
END;

{write byte value to element pointed to by p+n}
PROCEDURE PutPntrByte(p: POINTER; n: WORD; value: BYTE);
VAR ipntr: ^BYTE;
BEGIN
  ipntr := PntrAddNum(p,n,1);
  ipntr^ := value;
END;

FUNCTION MaxInt(a,b: INTEGER): INTEGER;
VAR _result: INTEGER;
BEGIN
  IF (a >= b) THEN _result := a ELSE _result := b;
  MaxInt := _result;
END;

FUNCTION MinInt(a,b: INTEGER): INTEGER;
VAR _result: INTEGER;
BEGIN
  IF (a <= b) THEN _result := a ELSE _result := b;
  MinInt := _result;
END;

FUNCTION MaxReal(a,b: Realtype): Realtype;
VAR _result: Realtype;
BEGIN
  IF (a >= b) THEN _result := a ELSE _result := b;
  MaxReal := _result;
END;

FUNCTION MinReal(a,b: Realtype): Realtype;
VAR _result: Realtype;
BEGIN
  IF (a <= b) THEN _result := a ELSE _result := b;
  MinReal := _result;
END;

FUNCTION GetMatError: INTEGER;
BEGIN
  GetMatError := virtualerr;
END;

{ assign a worldrect structure 'r' some new world values }
PROCEDURE SetWorldRect (VAR r: worldRect;
                       left, bottom, right, top : RealType );
BEGIN
	r.left := left;
	r.bottom :=  bottom;
	r.right := right;
	r.top := top;
END;

PROCEDURE qcprintmemerror( err: INTEGER);
VAR s: string;
BEGIN
  write('ERROR> ',err);
  writeln('A heap allocation memory error has occurred, resulting in a NIL pointer.');
{$IFDEF DETAILEDERRMESSAGES}
  case err OF
   0: s := 'No error.';
   8:  s := 'Error allocating memory for default fnt8x8.bin MSC font in initgraphics defaults (WORLDDR.C).';
   9:  s := '_registerfonts_ error (MSC only) (WORLDDR.C).';
   10: s := 'Memory alloc error in GetSEWindows (SELIB.C).';
   11: s := 'Memory alloc error in SortData (SEGRAPH.C).';
   12: s := 'Memory alloc error in LinePlotData (SEGRAPH.C).';
   13: s := 'Memory alloc error in AreaFillPlot (SEGRAPH.C).';
   14: s := 'Memory alloc error in BargraphData (SEGRAPH.C).';
   15: s := 'Memory alloc error in PlotErrorBars (SEGRAPH.C).';
   16: s := 'Memory alloc error in ScatterPlotData (SEGRAPH.C).';
   17: s := 'Memory alloc error in GroupPlotData (SEGRAPH.C).';
   18: s := 'Memory alloc error in ContourPlotLegends (SEGRAPH.C).';
   19: s := 'Memory alloc error in RealLegends (SEGRAPH.C).';
   20: s := 'Memory alloc error in ContourChartPolySurface2D (SEGRAPH.C).';
   21: s := 'Memory alloc error in AdvancedPrinterOutput (SEGRAPH.C).';
   30: s := 'Memory alloc error in QCCACHE.C.';
   35:  s := 'xms_init local buffer heap allocation error (QCCACHE).';
   50:  s := 'Icon image heap allocation error in rtdrawwinicon (SEGWIN).';
   60:  s := 'Temporary string array heap allocation error in gwritetrunc (QCMENU).';
   61:  s := 'Menu item heap allocation error in makeamenu (QCMENU).';
   70:  s := 'Button tag heap allocation error in setdialogboxoptions (QCDIALOG).';
   71:  s := 'Dialog frame heap allocation error in opendialogframe (QCDIALOG).';
   72:  s := 'Temporary string array heap allocation error in getdialoghelpfile (QCDIALOG).';
   73:  s := 'File dialog heap allocation error in openfiledialog (QCDIALOG).';
   74:  s := 'File dialog heap allocation error in makefilelist (QCDIALOG).';
   75:  s := 'File dialog heap allocation error in closefiledialog (QCDIALOG).';
   76:  s := 'General dialog heap allocation error in opengeneraldialogbox (QCDIALOG).';
   77:  s := 'Temporary string array heap allocation error in drawgeneraldialogbox (QCDIALOG).';
   78:  s := 'Temporary string array heap allocation error in closegeneraldialogbox (QCDIALOG).';
   79:  s := 'Checkoff dialog heap allocation error in opencheckoffdialogbox (QCDIALOG).';
   80:  s := 'List dialog heap allocation error in openlistdialog (QCDIALOG).';
   81:  s := 'Temporary string array heap allocation error in closelistdialog (QCDIALOG).';
   82:  s := 'Message dialog heap allocation error in openmessagedialog (QCDIALOG).';
   83:  s := 'Message dialog string heap allocation error in drawmessagedialogbox (QCDIALOG).';
   90:  s := 'Temporary string array heap allocation error in rthardcopyreturn (RTGCOMMO).';
   100:  s := 'Com buffer heap allocation error in opencom (ASYNC2).';
   110:  s := 'FFT temporary buffer heap allocation error int rtgetmem (RTFFT).';
   111:  s := 'FFT temporary buffer heap allocation error int rtfft2/rtrfft2 (RTFFT).';
   112:  s := 'FFT temporary buffer heap allocation error int rtreorder (RTFFT).';
   120:  s := 'Heap allocation error in readtcdatafile (RTTCREF).';
   130:  s := 'Heap allocation error in rtgaussjordan (RTCURVEF).';
   140:  s := 'PID Loop record memory allocation error (RTPID).';
   150:  s := 'Temporary string array heap allocation error in calclabelwidth (QCCNTRLS).';
   151:  s := 'Scroll bar record heap allocation error in qcopenscrollbar (QCCNTRLS).';
   152:  s := 'Scroll bar bank record heap allocation error in qcopenscrollbarbank (QCCNTRLS).';
   153:  s := 'Switch record heap allocation error in qcopenswitch (QCCNTRLS).';
   154:  s := 'Switch bank record heap allocation error in qcopenswitchbank (QCCNTRLS).';
   155:  s := 'Button record heap allocation error in qcopenbutton (QCCNTRLS).';
   156:  s := 'Button bank record heap allocation error in qcopenbuttonhbank (QCCNTRLS).';
   200:  s := 'ZBuffer alloc error in allocateZbuffer3D (CHARTOBJ.C).';
   201:  s := 'Polyfill buffer alloc error in fillpolygon3D (CHARTOBJ.C).';
   202:  s := 'Independent variable colormap alloc error in tinit3D (CHARTOBJ.C).';
   210:  s := 'Chart object alloc error in OpenChartObject3D (CHART3D.C).';
   211:  s := 'Scatter plot symbol alloc error (CHART3D.C).';
   212:  s := 'Memory alloc error in MakeWallAxesPlane3D (CHART3D.C).';
   213:  s := 'Memory alloc error in BarChart3D (CHART3D.C).';
   214:  s := 'Memory alloc error in BarChart25D (CHART3D.C).';
   215:  s := 'Memory alloc error in AreaRangeChart25D (CHART3D.C).';
   216:  s := 'Memory alloc error in LineChart25D (CHART3D.C).';
   217:  s := 'Memory alloc error in AreaFillChart25D (CHART3D.C).';
   218:  s := 'Memory alloc error in ScatterChart3D (CHART3D.C).';
   219:  s := 'Memory alloc error in GroupBarChart25D (CHART3D.C).';
   220:  s := 'Memory alloc error in GroupRibbonChart25D (CHART3D.C).';
   221:  s := 'Memory alloc error in GroupAreaFillChart25D (CHART3D.C).';
   222:  s := 'Memory alloc error in OpenPolySurface (CHART3D.C).';
   223:  s := 'Memory alloc error in AllocAdjacentPolygonList (CHART3D.C).';
   224:  s := 'Memory alloc error in ContourChartPolySurface3D (CHART3D.C).';
   230:  s := 'Memory alloc error in initfonttable3D (FONT3D.C).';
   240:  s := 'Memory alloc error in deltri (QCDELAUN.C).';
   241:  s := 'Memory alloc error in QCDealunayTriangles (QCDELAUN.C).';
   300:  s := 'Memory alloc error in SummaryStats (SUMSTATS.C).';
   301:  s := 'Memory alloc error in Histo (SUMSTATS.C).';
   302:  s := 'Memory alloc error in GaussJordan (GJ.C).';
   303:  s := 'Memory alloc error in ComplexGaussJordan (CGJ.C).';
   304:  s := 'Memory alloc error in PolyCurveFit (CURVEFI.C).';
   305:  s := 'Memory alloc error in CubicSplines (CURVEFI.C).';
   311:  s := 'Memory alloc error in fft2/rfft2 (FFT.C).';
   312:  s := 'Memory alloc error in reorder (FFT.C).';
   313:  s := 'Memory alloc error in FFT2DRCCalc (FFT.C).';
   314:  s := 'Memory alloc error in FFT2DCRCalc (FFT.C).';
   315:  s := 'Memory alloc error in FreqSampleFIR (FFT.C).';
   320:  s := 'Memory alloc error in MultipleReg (MULREG.C).';
   321:  s := 'Memory alloc error in MatInvert (MATMATH.C).';
   322:  s := 'Memory alloc error in CyclicJacobi (MATMATH.C).';
   323:  s := 'Memory alloc error in CMatInvert (MATMATH.C).';
  ELSE
    s := 'No error message for this error';
  END;
  writeln(s);
{$ENDIF}

END;

{ raise a number to a power }
PROCEDURE memerrfunction( err: INTEGER);
VAR qc_memerror: INTEGER;
BEGIN
  qc_memerror := QC_MEMERROR;
  rtlastmemerror := err;
  IF (qc_memerror=1) THEN
  BEGIN qcprintmemerror(err);
    halt(0);
  END;
END;

PROCEDURE qcmemerrfunction(err: INTEGER);
BEGIN
  memerrfunction(err);
END;

FUNCTION qcgetmemerror: INTEGER;
BEGIN
  qcgetmemerror := rtlastmemerror;
END;

FUNCTION rtpowercalc( realnum,  power: realtype): realtype;
VAR _result: realtype;
BEGIN
  _result := exp(power * ln(abs(realnum)));
  rtpowercalc := _result;
END;

{ generate a random number of realtype}
FUNCTION rtrandom: realtype;
VAR  _result: realtype;
BEGIN
  _result :=  (random(32767) / 32767.0);
  rtrandom := _result;
END;

FUNCTION getthevideomode: INTEGER;
BEGIN
  getthevideomode := 0;
END;

FUNCTION setthevideomode( vmode: INTEGER): INTEGER;
BEGIN
    setthevideomode := 0;
END;

FUNCTION _bios_printer(mode, p : integer; c : char): INTEGER;
BEGIN
   _bios_printer := 0;
END;


FUNCTION HeapOverflow(size: longint): BOOLEAN;
BEGIN
  IF (size+16) > (MaxAvail) THEN HeapOverflow := TRUE
  ELSE HeapOverflow := FALSE;
END;

FUNCTION  getcoreleft(VAR maxblock: LONGINT): LONGINT;
BEGIN
  getcoreleft := memavail;
  maxblock := maxavail;
END;
{** VIRTUAL ARRAY ROUTINES **}

{create virtual array on heap, initial all values to zero}
PROCEDURE DefMat(VAR m: matstruct; r,c: WORD; VAR err: integer);
VAR i,j: WORD;
   rpntr: RealPntr;
   rpntrpntr: ^RealPntr;
   totalsize, columnsize: longint;
BEGIN
  err := 0;
  m.modef := 0;
  IF (r > 4196) AND (c=1) THEN
  BEGIN
    m.modef := 1;
    c := (r div 4196) + 1;
    r := 4196;
  END
  ELSE m.modef := 0;
  columnsize := r*sizerealtype;
  totalsize := columnsize * c + c*4 + 16;
  IF totalsize > MemAvail THEN
    err := 1                             {not enough free heap blocks}
  ELSE
    IF (r>0) AND (c>0) THEN
    BEGIN
      IF HeapOverflow(c*4) THEN
        err := 2                         {not enough contig. heap}
      ELSE
        GetMem(m.mpntr,c*4);     {get heap block of c*4, start addr m.mpntr}
      IF err = 0 THEN
      BEGIN
        m.mr := r;               {matstruct m needs # rows & cols}
        m.mc := c;
        i := 0;
        WHILE ((i < m.mc) and (err = 0)) do
        BEGIN
          IF HeapOverflow(columnsize) THEN
           err := 2
          ELSE
          BEGIN
            GetMem(rpntr,m.mr*sizerealtype);     {get a row of heap}
            rpntrpntr := PntrAddNum(m.mpntr,i,4);
            rpntrpntr^ := rpntr;
            FillChar(rpntr^,m.mr*sizerealtype,0); {initialize to zero}
            INC(i,1);
          END;
        END;
        IF  err <> 0 THEN    {if error occurred, free all heap m was given}
        BEGIN
          FOR j := 0 TO i-1 do
          BEGIN
            rpntrpntr := PntrAddNum(m.mpntr,i,4);
            rpntr := rpntrpntr^;
            FreeMem(rpntr,m.mr*sizerealtype);
          END;
          FreeMem(m.mpntr,m.mc*4);
        END
      END;
    END;
  IF err <> 0 THEN
    write('Insufficient Heap Space for Matrix');
END;

{free memory from heap associated with m}
PROCEDURE FreeMat(VAR m: matstruct);
VAR i: WORD;
   rpntrpntr: ^RealPntr;
   rpntr: RealPntr;
BEGIN
  IF ((m.mc > 0) AND (m.mr > 0))  THEN
  BEGIN
    FOR i := 0 to m.mc-1 do
    BEGIN
      rpntrpntr := PntrAddNum(m.mpntr,i,4);
      rpntr := rpntrpntr^;
      IF rpntr <> NIL
        THEN FreeMem(rpntr,m.mr*sizerealtype);
    END;
    IF m.mpntr <> NIL THEN FreeMem(m.mpntr,m.mc*4);
  END
  ELSE
    virtualerr := 3;
  m.mc := 0;
  m.mr := 0;
END;

{write v to virtual array m at r,c}
PROCEDURE WrMat(m: matstruct; r,c: WORD; v: REALTYPE);
VAR rpntrpntr: ^RealPntr;
    rpntr: RealPntr;
BEGIN
  IF (m.modef = 1) THEN
  BEGIN
    c := r div 4196;
    r := r mod 4196;
  END;
  IF (c < m.mc) AND (r < m.mr) THEN
  BEGIN
    rpntrpntr := PntrAddNum(m.mpntr,c,4);
    rpntr := rpntrpntr^;
    PutPntrReal(rpntr,r,v);
  END
  ELSE
    virtualerr := 2;
END;

{read value from virtual array m at r,c}
FUNCTION RdMat(m: matstruct; r,c: WORD): REALTYPE;
VAR rpntrpntr: ^RealPntr;
    rpntr: RealPntr;
    _result: Realtype;
BEGIN
  _result := 0.0;
  IF (m.modef = 1) THEN
  BEGIN
    c := r div 4196;
    r := r mod 4196;
  END;
  IF (c < m.mc) AND (r < m.mr) THEN
  BEGIN
    rpntrpntr := PntrAddNum(m.mpntr,c,4);  {goto column c of m}
    rpntr := rpntrpntr^;
    _result := GetPntrReal(rpntr,r);        {get val at rpntr(r,c)}
  END
  ELSE
    virtualerr := 2;
  RdMat := _result;
END;

{write to all values in column c of virtual array m each value in p+i}
PROCEDURE CpyPntr2MatCol(p: POINTER; n: INTEGER;
                         m: matstruct; c: WORD);
VAR i: WORD;
BEGIN
   for i := 0 to n-1 do
     WrMat(m,i,c,GetPntrReal(p,i));
END;

{write to all values in row r of virtual array m
 each value in p+i}
PROCEDURE CpyPntr2MatRow(p: POINTER; n: INTEGER;
                         m: matstruct; r: WORD);
VAR i: WORD;
BEGIN
   for i := 0 to n-1 do
     WrMat(m,r,i,GetPntrReal(p,i));
END;

PROCEDURE CpyMat2Pntr(m: matstruct; c: word;
                      p: POINTER; n: word);
VAR i: WORD;
BEGIN
   for i := 0 to n-1 do
     PutPntrReal(p,i,RdMat(m,i,c));
END;

BEGIN
  heaperrorflag := 0;
  HeapError := @HeapErrorFUNC;

  sizerealtype := sizeof(realtype);
  sizereal     := sizeof(real);
  sizesingle   := sizeof(single);
  sizedouble   := sizeof(double);
  sizeinteger  := sizeof(integer);
  sizepointer  := sizeof(pointer);
  sizelong     := sizeof(longint);
  sizes40 := sizeof(_string40);
  sizes80 := sizeof(_string80);

END.


